home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 4
/
FM Towns Free Software Collection 4 - Disc 1.iso
/
msdos
/
label
/
lb.bas
< prev
next >
Wrap
BASIC Source File
|
1991-10-18
|
36KB
|
1,295 lines
DECLARE FUNCTION Line.Edit$ (Arg$, Length%, LastKey$, strflag%)
DECLARE SUB New.Data ()
DECLARE SUB PageCopy ()
DECLARE SUB Save.DEF ()
DECLARE SUB DATAX ()
DECLARE SUB Disp.TOKEI ()
DECLARE SUB UpPage (Page%, Count%)
DECLARE SUB DownPage (Page%, Count%)
DECLARE SUB MENU ()
DECLARE SUB InsLine ()
DECLARE SUB DelLine ()
DECLARE SUB Gamen ()
DECLARE SUB Clear.Msg ()
DECLARE SUB Heiten ()
DECLARE SUB Func.ON (PF.Number AS INTEGER)
DECLARE SUB Set.KGM (SetNO AS INTEGER)
DECLARE SUB Data.Clear ()
DECLARE SUB Set.Data ()
DECLARE SUB NO.Data ()
DECLARE SUB Disp.Name ()
DECLARE SUB Boo ()
DECLARE SUB Disp.Func ()
DECLARE SUB Data.Load ()
DECLARE SUB Data.Save ()
DECLARE SUB Data.Set ()
DECLARE SUB Disp.Help ()
DECLARE SUB Disp.Page (Page%)
DECLARE SUB ENDING ()
DECLARE SUB Write.LCR (FG AS INTEGER)
' ┏━━━━━━┯━━━━━━━━━━━━━━━━━━━┓
' ┃プログラム名│LB.BAS (LB.EXE) ┃
' ┃タ イ ト ル │簡易版印刷屋さん Ver. 3.00 ┃
' ┃プログラマー│NIF ID:MAG01022 Trouble・MakerのJ.J┃
' ┠──────┼───────────────────┨
' ┃使 用 機種│富士通 FM TOWNS モデル2H ┃
' ┃使 用 言語│Microsoft QuickBASIC 4.5 + MASM 5.1 ┃
' ┠──────┼───────────────────┨
' ┃制 作 日 付 │For 1991.01.03 to 1991.01.15 ┃
' ┗━━━━━━┷━━━━━━━━━━━━━━━━━━━┛
'$INCLUDE: 'JJ.BI'
'----------------------- 初期設定
CLEAR
DIM SHARED In$(12) ' 編集用文書データ
DIM SHARED Saizu(12) AS INTEGER ' サイズデータ
DIM SHARED Sonota(4) AS INTEGER ' DEFファイル
DIM SHARED SONO$(4)
DIM SHARED N AS INTEGER ' 汎用変数
DIM SHARED CY AS INTEGER ' カーソル Y ザヒョウ
DIM SHARED Ins% ' インサート フラグ
DIM SHARED Drive$ ' データ ドライブ&データメイ
DIM SHARED CurDir$ ' カレントディレクトリィ
CONST maxpage% = 30 ' 最大登録 Page 数
DIM SHARED Saizu.Data(maxpage) AS STRING * 10 ' サイズ データ
DIM SHARED Bun.Data(maxpage) AS STRING * 432 ' 文書 データ
DIM SHARED Page.No% ' Page ナンバー
CONST YN.MSG$ = "○:実 行 ×:取 消"
CONST ERR.MSG$ = "中止<A>, もう一度<R>, 無視<I>? "
CONST NG = 0
CONST OK = -1
'-----------------------------------------------------------------------
DriveNo% = GetCurDrive ' カレントディレクトリィ NO
CurDir$ = GetCurDir$(DriveNo%) ' カレントディレクトリィ
ANS% = CheckFile%(CurDir$ + "LABEL.DEF") ' DEFファイル CHECK
IF ANS% = 0 THEN bell 800, 32: bell 620, 40: PRINT "LABEL.DEF がありません!!": END
OPEN CurDir$ + "LABEL.DEF" FOR RANDOM AS 2 LEN = 48
FIELD #2, 36 AS Drive.Name$, 12 AS Sonota.Data$
GET #2, 1
Drive$ = Drive.Name$: SD$ = Sonota.Data$
P = 1
FOR I = 1 TO 4
Sonota(I) = VAL(MID$(SD$, P, 3))
P = P + 3
NEXT I
CLOSE #2
Drive$ = RTRIM$(Drive$)
ON ERROR GOTO ErrorProc ' エラー ショリ ルーチン
'==============================================================================
Gamen ' 画面描画
CY = 5: cx = 23 ' ショキ カーソル イチ
DO
DO: LOOP WHILE INKEY$ <> "" ' キーバッフアークリアー
LOCATE 1, 37, 0: COLOR 0, 3: PRINT USING "##"; CY - 4; : COLOR 7, 0
LOCATE CY, cx
N = CY - 4
In$(N) = Line.Edit$(In$(N), 36, LastKey$, 0)
Clear.Msg
SELECT CASE LastKey$
CASE CHR$(13), CHR$(0, &H50), CHR$(&H18) ' リターンキー,DOWN,^C
GOSUB Pos.Down
CASE CHR$(&H1B) ' ESC
Heiten
CASE CHR$(0, &H48), CHR$(&H5) ' UP,^E
GOSUB Pos.Up
CASE CHR$(0, &H47), CHR$(&HA) ' HOME,^J
Disp.Help
CASE CHR$(0, &H3B) ' PF1
Func.ON 1: Set.KGM 1
CASE CHR$(0, &H3C) ' PF2
Func.ON 2: Set.KGM 2
CASE CHR$(0, &H3D) ' PF3
Func.ON 3: Set.KGM 3
CASE CHR$(0, &H3E) ' PF4
Func.ON 4: Set.KGM 4
CASE CHR$(0, &H3F) ' PF5
Func.ON 5: Data.Clear
CASE CHR$(0, &H40) ' PF6
Func.ON 6: GOSUB Print.OUT
CASE CHR$(0, &H41) ' PF7
Func.ON 7: Write.LCR 1
CASE CHR$(0, &H42) ' PF8
Func.ON 8: Write.LCR 2
CASE CHR$(0, &H43) ' PF9
Func.ON 9: Write.LCR 3
CASE CHR$(0, &H44) ' PF10
Func.ON 10: MENU
CASE CHR$(0, &H85) ' PF11
DownPage Page.No%, 5
CASE CHR$(0, &H86) ' PF12
UpPage Page.No%, 5
CASE CHR$(0, &H5D) ' SHIFT+PF10
IF N > 1 THEN In$(N) = In$(N - 1)
CASE CHR$(0, &H51), CHR$(&H3) ' 次行
UpPage Page.No%, 1
CASE CHR$(0, &H49), CHR$(&H12) ' 前行
DownPage Page.No%, 1
CASE CHR$(&H19) ' ^Y
DelLine
CASE CHR$(&HE) ' ^N
InsLine
'-----------------------------------------------------------------------------
' CASE CHR$(0, &H54) ' SHIFT+PF1
' CASE CHR$(0, &H55) ' SHIFT+PF2
' CASE CHR$(0, &H56) ' SHIFT+PF3
' CASE CHR$(0, &H57) ' SHIFT+PF4
' CASE CHR$(0, &H58) ' SHIFT+PF5
' CASE CHR$(0, &H59) ' SHIFT+PF6
' CASE CHR$(0, &H5A) ' SHIFT+PF7
' CASE CHR$(0, &H5B) ' SHIFT+PF8
' CASE CHR$(0, &H5C) ' SHIFT+PF9
' CASE CHR$(0, &H87) ' SHIFT+PF11 Line.Editで使用
' CASE CHR$(0, &H88) ' SHIFT+PF12 〃
' CASE CHR$(&H18) ' 取消 CHR$(24) ^Xと同じ
CASE ELSE
bell 600, 32
END SELECT
LOOP
END
'==============================================================================
Pos.Up: IF CY = 5 THEN CY = 16: RETURN ELSE CY = CY - 1: RETURN
Pos.Down: IF CY = 16 THEN CY = 5: RETURN ELSE CY = CY + 1: RETURN
'------------------------------------------------------ 印 刷
Print.OUT:
FOR N = 1 TO 12
IF In$(N) <= SPACE$(36) THEN ELSE GOTO Print.OK
NEXT N
NO.Data
RETURN
Print.OK:
bell 650, 32: bell 650, 32
box 22, 18, 59, 22, 10, 2
COLOR 14
LOCATE 19, 31: PRINT " 印刷を行います. "
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
Dame:
A$ = In.Key$
SELECT CASE A$
CASE CHR$(13)
Clear.Msg
GOTO Lprint.OK
CASE CHR$(24), CHR$(27)
Clear.Msg
RETURN
CASE ELSE
bell 600, 32
GOTO Dame
END SELECT
Lprint.OK:
LPRINT CHR$(27); "c"; ' リセット
GOSUB Print.LP ' カイギョウ ピッチ
GOSUB Print.LMRG ' レフト マ-ジン
FOR LP = 1 TO Sonota(1): LPRINT : NEXT LP ' 紙送り
box 22, 19, 59, 21, 6, 2
COLOR 14
LOCATE 20, 30: PRINT " ** 印 刷 中 ** "
COLOR 7
FOR P = 1 TO 12
SELECT CASE Saizu(P)
CASE 0, 1
GOSUB Print.KGM11
CASE 2
GOSUB Print.KGM12
CASE 3
GOSUB Print.KGM21
CASE 4
GOSUB Print.KGM22
END SELECT
LPRINT In$(P)
NEXT P
IF Sonota(4) = 1 THEN LPRINT CHR$(12); ' フォームフィード
Clear.Msg
Print.END: ' 印刷終了
RETURN
'------------------------------------------------------ 改行ピッチ
Print.LP:
J = Sonota(3)
P1 = INT(J / 10)
P2 = INT(J - (P1 * 10))
LPRINT CHR$(28); "%";
LPRINT CHR$(&H20 + P1); CHR$(&H70 + P2);
RETURN
'------------------------------------------------------ 左マージン
Print.LMRG:
J = Sonota(2)
P1 = INT(J / 1000)
P2 = INT((J - P1 * 1000) / 100)
P3 = INT((J - (P1 * 1000 + P2 * 100)) / 10)
P4 = INT(J - (P1 * 1000 + P2 * 100 + P3 * 10))
LPRINT CHR$(27); "Q";
LPRINT CHR$(&H31); CHR$(&H38);
LPRINT ";";
LPRINT CHR$(&H30 + P1); CHR$(&H30 + P2);
LPRINT CHR$(&H30 + P3); CHR$(&H30 + P4);
LPRINT " Q";
RETURN
'------------------------------------------------------ 標 準
Print.KGM11:
LPRINT CHR$(28); "$"; ' 漢字文字ピッチ27/180
LPRINT CHR$(&H22); CHR$(&H77);
LPRINT CHR$(28); "'";
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H70);
RETURN
'------------------------------------------------------ 横 倍
Print.KGM12:
LPRINT CHR$(28); "$"; ' 漢字文字ピッチ24/180
LPRINT CHR$(&H22); CHR$(&H74);
LPRINT CHR$(28); "'";
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H70);
RETURN
'------------------------------------------------------ 縦 倍
Print.KGM21:
' LPRINT CHR$(28); "."; "t";
LPRINT CHR$(28); "'";
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H21); CHR$(&H20); CHR$(&H70);
RETURN
'------------------------------------------------------ 4 倍
Print.KGM22:
LPRINT CHR$(28); "$"; ' 漢字文字ピッチ24/180
LPRINT CHR$(&H22); CHR$(&H74);
' LPRINT CHR$(28); "."; "t";
LPRINT CHR$(28); "'";
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H60);
LPRINT CHR$(&H22); CHR$(&H20); CHR$(&H70);
RETURN
'=============================================================================
PFDATA:
DATA " 標準 "
DATA " 横倍 "
DATA " 縦倍 "
DATA " 4倍 "
DATA " 削除 "
DATA " 印刷 "
DATA " 左寄 "
DATA " 中央 "
DATA " 右寄 "
DATA " MENU "
SttMsgLst:
DATA "おしながき"
DATA "Q Quit :プログラム終了"
DATA "S SetSystem:ちょっとだけ設定"
DATA "D DataSet :データ変更"
DATA "P PageCopy :ページコピー"
DATA "T TimeDisp :時計の表示"
HELPDATA:
DATA " 簡易版印刷屋さん Ver. 3.00"
DATA "┏━━━━━━┯━━━━━━━━━━━━━━┓┏━━━┯━━━━━━━━━┓"
DATA "┃ ↑ CTRL+E│カーソルを1行上に移動する ┃┃CTRL+Y│カーソル行削除 ┃"
DATA "┃ ↓ CTRL+X│カーソルを1行下に移動する ┃┃CTRL+N│カーソル行挿入 ┃"
DATA "┃ ← CTRL+S│カーソルを1文字左に移動する┃┃CTRL+K│カーソルの右側削除┃"
DATA "┃ → CTRL+D│カーソルを1文字右に移動する┃┃CTRL+U│カーソルの左側削除┃"
DATA "┃前行 CTRL+R│1ページ前を表示します ┃┗━━━┷━━━━━━━━━┛"
DATA "┃次行 CTRL+C│1ページ次を表示します ┃"
DATA "┃PF11 │5ページ前を表示します ┃┌─────────────┐"
DATA "┃PF12 │5ページ次を表示します ┃│ データ名の例 ┃"
DATA "┃削除 CTRL+G│カーソル位置の1文字を削除 ┃│ A:\LABEL.DAT ┃"
DATA "┃ BS CTRL+H│カーソルの直前の1文字を削除┃│ B:\LB\LABEL.DAT ┃"
DATA "┃挿入 │<挿入>・[上書]の切り換え ┃│ ┃"
DATA "┃HOME CTRL+J│ヘルプ画面表示を表示します ┃│注意:LABEL.DEFという名前は┃"
DATA "┃ESC │簡易版印刷屋さんを閉店します┃│ 使用してはいけません.┃"
DATA "┠──────┼──────────────┨└━━━━━━━━━━━━━┛"
DATA "┃ SHIFT+PF10│上の行複写 ┃"
DATA "┃ SHIFT+PF11│カーソルを行の左端に移動する┃┌─────────────┐"
DATA "┃ SHIFT+PF12│カーソルを行の右端に移動する┃│ 何かキーを押すと戻ります ┃"
DATA "┗━━━━━━┷━━━━━━━━━━━━━━┛└━━━━━━━━━━━━━┛"
'------------------------------------------------------ エラー処理
ErrorProc:
SELECT CASE ERR
CASE 25, 27
bell 800, 32: bell 620, 40
box 22, 18, 59, 22, 14, 2
COLOR 15
LOCATE 20, 28: PRINT " プリンターを確認して下さい."
COLOR 7
RESUME Print.END
CASE 64:
bell 800, 32: bell 620, 40
box 22, 18, 59, 22, 14, 2
COLOR 7
LOCATE 19, 25: PRINT "ファイル名に誤りがあります."
LOCATE 21, 25: PRINT ERR.MSG$
GOTO Err.Input
CASE 71:
bell 800, 32: bell 620, 40
box 22, 18, 59, 22, 14, 2
COLOR 7
LOCATE 19, 25: PRINT MID$(Drive$, 1, 1)
LOCATE 19, 26: PRINT " ドライブの準備ができていません."
LOCATE 21, 25: PRINT ERR.MSG$
GOTO Err.Input
CASE 52, 53, 75, 76:
bell 800, 32: bell 620, 40
box 22, 18, 59, 22, 14, 2
COLOR 7
LOCATE 19, 24: PRINT "ファイルまたはパスが見つかりません."
LOCATE 21, 25: PRINT ERR.MSG$
GOTO Err.Input
CASE ELSE:
clrscr
bell 800, 32: bell 620, 40
CLS
PRINT "未処理のエラーが発生しました. ERR="; ERR
ON ERROR GOTO 0
END SELECT
Err.Input:
DO
Char$ = UCASE$(INPUT$(1))
IF Char$ = "I" THEN
Clear.Msg
Drive$ = CurDir$ + "LABEL.DAT"
Disp.Name
RESUME ' 元のステートメントに戻ります.
ELSEIF Char$ = "R" THEN
Restart = TRUE ' プログラムの先頭に戻ります.
Clear.Msg
RESUME NEXT
ELSEIF Char$ = "A" THEN
END ' プログラムを終了します.
END IF
LOOP
SUB Boo
bell 500, 32: bell 500, 32
box 22, 19, 59, 21, 14, 2
LOCATE 20, 31, 0: COLOR 12: PRINT "この行は、出来ません.": COLOR 7
END SUB
SUB Clear.Msg
clrxy 1, 18, 60, 24
Disp.Func
END SUB
'--------------
' データ削除
'--------------
SUB Data.Clear
FOR N = 1 TO 12
IF In$(N) <= SPACE$(36) THEN ELSE GOTO Del.OK
NEXT N
NO.Data
EXIT SUB
Del.OK:
bell 650, 36: bell 650, 36
box 22, 18, 59, 22, 14, 2
COLOR 14
LOCATE 19, 27: PRINT "このPageを削除していいですか?"
COLOR 7
LOCATE 21, 31: PRINT YN.MSG$
DO
ANS$ = In.Key$
SELECT CASE ANS$
CASE CHR$(13)
Clear.Msg
FOR I = 1 TO 12
LOCATE I + 4, 10, 0: PRINT "○ "
LOCATE I + 4, 23: PRINT SPACE$(36);
In$(I) = SPACE$(36)
Saizu(I) = 1
NEXT I
EXIT DO
CASE CHR$(24), CHR$(27)
Clear.Msg
EXIT DO
CASE ELSE
bell 600, 32
END SELECT
LOOP
CY = 5
END SUB
SUB Data.Load STATIC
OPEN Drive$ FOR APPEND AS #1
CLOSE #1
OPEN Drive$ FOR INPUT AS #1
rec = 0
WHILE NOT EOF(1)
rec = rec + 1
INPUT #1, Saizu.Data(rec)
INPUT #1, Bun.Data(rec)
WEND
CLOSE #1
END SUB
SUB Data.Save
OPEN Drive$ FOR OUTPUT AS #1
FOR rec = 1 TO maxpage
WRITE #1, Saizu.Data(rec)
WRITE #1, Bun.Data(rec)
NEXT
CLOSE #1
END SUB
SUB Data.Set
FOR I = 1 TO 12
Save.Data$ = Save.Data$ + LEFT$(In$(I) + SPACE$(36), 36)
Save.Saizu$ = Save.Saizu$ + RIGHT$(" " + MID$(STR$(Saizu(I)), 2), 1)
NEXT I
Saizu.Data(Page.No%) = Save.Saizu$
Bun.Data(Page.No%) = Save.Data$
END SUB
SUB DATAX
Data.Save
gettext
box 22, 11, 59, 13, 3, 0
COLOR 0, 3
LOCATE 11, 23: PRINT "データドライブ&データ名"
LOCATE 13, 23: PRINT CurDir$ ' カレントディレクトリィ
COLOR 7, 0
FOR I = 1 TO 4
SONO$(I) = MID$(STR$(Sonota(I)), 2)
NEXT I
DO
In.Drive:
Ins% = OK
LOCATE 12, 23
IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = CurDir$ + Drive$
Drive$ = Line.Edit$(Drive$, 36, LastKey$, 0)
IF Drive$ <= SPACE$(36) OR LEN(Drive$) = LEN(CurDir$) THEN
bell 800, 32: bell 620, 40
box 22, 19, 59, 21, 14, 2
COLOR 7
LOCATE 20, 28: PRINT "データ名を入力してください."
GOTO In.Drive
END IF
IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = LEFT$(CurDir$ + Drive$ + SPACE$(36), 36)
Drive$ = UCASE$(Drive$)
SELECT CASE LastKey$
CASE CHR$(13), CHR$(0, &H50), CHR$(&H18) ' リターンキー,DOWN
puttext
Save.DEF
Drive$ = RTRIM$(Drive$)
Disp.Name
Ins% = OK
EXIT SUB
CASE ELSE
EXIT DO
END SELECT
LOOP
puttext
Ins% = OK
END SUB
'------------
' 一行削除
'------------
SUB DelLine
FOR I = N TO 11
In$(I) = In$(I + 1)
Saizu(I) = Saizu(I + 1)
NEXT I
scroll 0, 10, CY, 20, 16, 1
scroll 0, 23, CY, 58, 16, 1
In$(12) = SPACE$(36)
Saizu(12) = 1
LOCATE 16, 23: PRINT SPACE$(36);
LOCATE 16, 10: PRINT "○ "
END SUB
SUB Disp.Func
LOCATE , , 0
textcolor 23
RESTORE PFDATA
FOR Row = 1 TO 10
gotoxy Row * 7 - 6, 25
READ tmp$: puts tmp$
NEXT
textcolor 7
END SUB
SUB Disp.Help
gettext
box 1, 1, 80, 22, 6, 2
RESTORE HELPDATA
FOR Row = 1 TO 20
gotoxy 3, Row + 1
READ tmp$: puts tmp$
NEXT
A$ = In.Key$
puttext
END SUB
SUB Disp.Name
textcolor 19: gotoxy 1, 1: puts SPACE$(34)
textcolor 23: gotoxy 1, 1: puts Drive$: textcolor 7
Ins% = OK: Page.No% = 1
ANS% = CheckFile%(Drive$) ' DATAファイル CHECK
IF ANS% = 0 THEN New.Data
Data.Load
Disp.Page Page.No%
END SUB
'------------------
' 1ページデータ表示
'------------------
SUB Disp.Page (Page%)
LOCATE 4, 62, 0
PRINT USING "Page : & &"; CDBL$(RIGHT$(" " + STR$(Page%), 2));
P = 1
FOR N = 1 TO 12
In$(N) = MID$(Bun.Data(Page%), P, 36)
Saizu(N) = VAL(MID$(Saizu.Data(Page%), N, 1))
P = P + 36
NEXT N
FOR N = 1 TO 12
SELECT CASE Saizu(N)
CASE 0, 1
Set.KGM 1
CASE 2
Set.KGM 2
CASE 3
Set.KGM 3
CASE 4
Set.KGM 4
END SELECT
LOCATE N + 4, 23: PRINT In$(N)
XPOS = LEN(RTRIM$(In$(N)))
IF XPOS < 36 THEN
LOCATE N + 4, 23 + XPOS
textcolor 6
putc (&H1F)
textcolor 7
END IF
NEXT N
END SUB
DEFINT A-Z
SUB Disp.TOKEI
gettext
box 3, 5, 77, 17, 3, 0
textcolor 19
gotoxy 53, 17: puts "何かキーを押すと戻ります"
textcolor 7
DO
textcolor 6
FOR I = 1 TO 8
MSG$ = MID$(TIME$, I, 1)
SELECT CASE I
CASE 1
XPOS = 6
CASE 2
XPOS = 17
CASE 3
XPOS = 28
CASE 4
XPOS = 30
CASE 5
XPOS = 41
CASE 6
XPOS = 52
CASE 7
XPOS = 54
CASE 8
XPOS = 65
END SELECT
SELECT CASE MSG$
CASE "0"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts "● ●"
gotoxy XPOS, 9: puts "● ●"
gotoxy XPOS, 10: puts "● ●"
gotoxy XPOS, 11: puts "● ●"
gotoxy XPOS, 12: puts "● ●"
gotoxy XPOS, 13: puts "● ●"
gotoxy XPOS, 14: puts "● ●"
gotoxy XPOS, 15: puts "●●●●●"
CASE "1"
gotoxy XPOS, 7: puts " ●"
gotoxy XPOS, 8: puts " ●"
gotoxy XPOS, 9: puts " ●"
gotoxy XPOS, 10: puts " ●"
gotoxy XPOS, 11: puts " ●"
gotoxy XPOS, 12: puts " ●"
gotoxy XPOS, 13: puts " ●"
gotoxy XPOS, 14: puts " ●"
gotoxy XPOS, 15: puts " ●"
CASE "2"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts " ●"
gotoxy XPOS, 9: puts " ●"
gotoxy XPOS, 10: puts " ●"
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts "● "
gotoxy XPOS, 13: puts "● "
gotoxy XPOS, 14: puts "● "
gotoxy XPOS, 15: puts "●●●●●"
CASE "3"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts " ●"
gotoxy XPOS, 9: puts " ●"
gotoxy XPOS, 10: puts " ●"
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts " ●"
gotoxy XPOS, 13: puts " ●"
gotoxy XPOS, 14: puts " ●"
gotoxy XPOS, 15: puts "●●●●●"
CASE "4"
gotoxy XPOS, 7: puts "● ●"
gotoxy XPOS, 8: puts "● ●"
gotoxy XPOS, 9: puts "● ●"
gotoxy XPOS, 10: puts "● ●"
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts " ●"
gotoxy XPOS, 13: puts " ●"
gotoxy XPOS, 14: puts " ●"
gotoxy XPOS, 15: puts " ●"
CASE "5"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts "● "
gotoxy XPOS, 9: puts "● "
gotoxy XPOS, 10: puts "● "
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts " ●"
gotoxy XPOS, 13: puts " ●"
gotoxy XPOS, 14: puts " ●"
gotoxy XPOS, 15: puts "●●●●●"
CASE "6"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts "● "
gotoxy XPOS, 9: puts "● "
gotoxy XPOS, 10: puts "● "
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts "● ●"
gotoxy XPOS, 13: puts "● ●"
gotoxy XPOS, 14: puts "● ●"
gotoxy XPOS, 15: puts "●●●●●"
CASE "7"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts " ●"
gotoxy XPOS, 9: puts " ●"
gotoxy XPOS, 10: puts " ●"
gotoxy XPOS, 11: puts " ●"
gotoxy XPOS, 12: puts " ●"
gotoxy XPOS, 13: puts " ●"
gotoxy XPOS, 14: puts " ●"
gotoxy XPOS, 15: puts " ●"
CASE "8"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts "● ●"
gotoxy XPOS, 9: puts "● ●"
gotoxy XPOS, 10: puts "● ●"
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts "● ●"
gotoxy XPOS, 13: puts "● ●"
gotoxy XPOS, 14: puts "● ●"
gotoxy XPOS, 15: puts "●●●●●"
CASE "9"
gotoxy XPOS, 7: puts "●●●●●"
gotoxy XPOS, 8: puts "● ●"
gotoxy XPOS, 9: puts "● ●"
gotoxy XPOS, 10: puts "● ●"
gotoxy XPOS, 11: puts "●●●●●"
gotoxy XPOS, 12: puts " ●"
gotoxy XPOS, 13: puts " ●"
gotoxy XPOS, 14: puts " ●"
gotoxy XPOS, 15: puts "●●●●●"
CASE ":"
gotoxy XPOS, 9: putc (&HEA)
gotoxy XPOS, 13: putc (&HEA)
END SELECT
NEXT
A$ = INKEY$
LOOP WHILE A$ = ""
textcolor 7
puttext
END SUB
DEFSNG A-Z
SUB DownPage (Page%, Count%)
Data.Set
Page.No% = Page% - Count%
IF Page.No% < 1 THEN Page.No% = maxpage%
Disp.Page Page.No%
END SUB
SUB ENDING
box 20, 6, 59, 12, 6, 2
gotoxy 26, 8: puts " 毎度ありがとうございました "
gotoxy 26, 10: puts "またの御来店お待ちしています"
LOCATE 20, 1: COLOR 7, 0
END
END SUB
SUB Func.ON (PF.Number AS INTEGER)
RESTORE PFDATA
FOR Row = 1 TO PF.Number
READ tmp$
NEXT
gotoxy PF.Number * 7 - 6, 25
textcolor 22: puts tmp$: textcolor 7
END SUB
'------------
' 画面描画
'------------
SUB Gamen
clrscr
CLS
textcolor 19
gotoxy 1, 1: puts SPACE$(80)
gotoxy 35, 1: puts "[ : ]"
gotoxy 69, 1: puts "HOMEでヘルプ"
gotoxy 71, 2
TUKI$ = RIGHT$(" " + STR$(VAL(MID$(DATE$, 6, 2))), 2)
HI$ = RIGHT$(" " + STR$(VAL(MID$(DATE$, 9))), 2)
textcolor 6
puts MID$(DATE$, 3, 2) + CHR$(&H1B) + CHR$(&HF2)
puts TUKI$ + CHR$(&H1B) + CHR$(&HF3)
puts HI$ + CHR$(&H1B) + CHR$(&HF4)
textcolor 2
gotoxy 10, 3: puts "標 横 縦 4"
box 9, 4, 21, 17, 3, 2: box 22, 4, 59, 17, 9, 2
textcolor 9: gotoxy 43, 4: putc (&H91): gotoxy 43, 17: putc (&H90)
Disp.Func
Disp.Name
textcolor 7
END SUB
'----------------
' みせじまい?
'----------------
SUB Heiten
bell 800, 32: bell 620, 40
box 22, 18, 59, 22, 15, 2
COLOR 15: LOCATE 19, 31: PRINT "閉店してもよいですか?"
COLOR 7: LOCATE 21, 31: PRINT YN.MSG$
DO
A$ = In.Key$
SELECT CASE A$
CASE CHR$(13)
Data.Set
Data.Save
clrscr
ENDING
CASE CHR$(24), CHR$(27)
Clear.Msg
EXIT DO
CASE ELSE
bell 600, 32
END SELECT
LOOP
END SUB
'------------
' 一行挿入
'------------
SUB InsLine
FOR I = 12 TO N STEP -1
In$(I) = In$(I - 1)
Saizu(I) = Saizu(I - 1)
NEXT I
scroll 1, 10, CY, 20, 16, 1
scroll 1, 23, CY, 58, 16, 1
In$(N) = SPACE$(36)
Saizu(N) = 1
LOCATE CY, 23: PRINT SPACE$(36);
LOCATE CY, 10: PRINT "○ "
END SUB
DEFINT A-Z
'--------------------
' ラインエディター
'--------------------
FUNCTION Line.Edit$ (Arg$, Length%, LastKey$, strflag%)
X0% = POS(0)
Y0% = CSRLIN: IF X0% + Length% > 80 THEN ERROR 5
ChangeFlag% = OK
COLOR 7, 0
dx% = 0
' Ins% = OK
tmp$ = LEFT$(Arg$ + SPACE$(Length%), Length%)
DO
' DO: LOOP WHILE INKEY$ <> "" ' キーバッフアークリアー
MaxCharNum% = KLEN(tmp$)
'-------------------------------------
IF dx% >= Length% THEN dx% = Length% - 1 ELSE dx% = dx%
LOCATE 1, 41, 0
COLOR 0, 3
PRINT USING "##"; dx% + 1;
COLOR 7, 0
'-------------------------------------
FOR I% = 1 TO MaxCharNum%
IF KPOS(tmp$, I%) <= Length% THEN MaxByte% = KPOS(tmp$, I%)
NEXT
IF dx% + 1 >= Length% THEN dx% = MaxByte% - 1
LastByte% = ASC(MID$(tmp$, MaxByte%, 1))
IF LastByte% >= &H80 AND (LastByte% < &HA0 OR LastByte% > &HDF) THEN
IF MaxByte% = Length% THEN
tmp$ = LEFT$(tmp$, MaxByte% - 1) + " "
END IF
END IF
' CharNum% = MaxCharNum% + 1 ' 一番右で削除キーを押すとエラーになる?
CharNum% = MaxCharNum%
FOR I% = 1 TO MaxCharNum% - 1
IF KPOS(tmp$, I%) = dx% + 1 THEN CharNum% = I%
NEXT
'------------------------------------------------------ a$=INKEY$ ココニアッタ
tmp$ = LEFT$(tmp$ + SPACE$(Length%), Length%)
IF ChangeFlag% = OK THEN
IF px% < dx% THEN
LOCATE Y0%, X0% + px%, 0
PRINT MID$(tmp$, px% + 1);
ELSE
LOCATE Y0%, X0% + dx%, 0
PRINT MID$(tmp$, dx% + 1);
END IF
ChangeFlag% = NG
'-------------------------------------------------
XPOS = LEN(RTRIM$(tmp$))
IF XPOS < 36 AND strflag > -1 THEN
LOCATE Y0%, X0% + XPOS
textcolor 6
putc (&H1F)
textcolor 7
END IF
'-------------------------------------------------
END IF
px% = dx%
'-------------------------------------------------
COLOR 0, 3
IF Ins% = NG THEN
LOCATE 1, 53: PRINT "[上書]"
ELSE LOCATE 1, 53: PRINT "<挿入>"
END IF
COLOR 7, 0
'-------------------------------------------------
LOCATE Y0%, X0% + dx%, 1, -(Ins% = OK) * 13, 15
A$ = In.Key$
Clear.Msg
LastKey$ = A$
SELECT CASE A$
CASE CHR$(0, &H4B), CHR$(&H13) ' 左矢印
dx% = dx% - 1
IF dx% < 0 THEN
dx% = 0
ELSE
IF SCREEN(Y0%, X0% + dx%) < 0 THEN dx% = dx% - 1
END IF
CASE CHR$(0, &H4D), CHR$(&H4) ' 右矢印
IF SCREEN(Y0%, X0% + dx%) > 255 THEN dx% = dx% + 1
dx% = dx% + 1
CASE CHR$(0, &H52) ' 挿入
Ins% = (Ins% = NG)
CASE CHR$(0, &H53), CHR$(&H7) ' 削除 or^G
ChangeFlag% = OK
tmp$ = KMID$(tmp$, 1, CharNum% - 1) + KMID$(tmp$, CharNum% + 1, LEN(tmp$) - CharNum%) + " "
CASE CHR$(8) 'バックスペース
ChangeFlag% = OK
dx% = dx% - 1
IF dx% < 0 THEN
dx% = 0
ELSE
IF SCREEN(Y0%, X0% + dx%) < 0 THEN dx% = dx% - 1
END IF
IF CharNum% >= 2 THEN tmp$ = KMID$(tmp$, 1, CharNum% - 2) + KMID$(tmp$, CharNum%, LEN(tmp$) - CharNum% + 1) + " "
IF CharNum% = 1 THEN tmp$ = KMID$(tmp$, 1, CharNum% - 1) + KMID$(tmp$, CharNum% + 1, LEN(tmp$) - CharNum%) + " "
CASE CHR$(0, &H87) ' SHIFT+PF11
dx% = 0
' CASE CHR$(0, &H4F) ' F14
CASE CHR$(0, &H88) ' SHIFT+PF12
dx% = LEN(RTRIM$(tmp$))
CASE CHR$(&HB) ' ^K カーソル以降削除
ChangeFlag% = OK
tmp$ = LEFT$(tmp$, dx%)
tmp$ = LEFT$(tmp$ + SPACE$(Length%), Length%)
CASE CHR$(&H15) ' ^U 行頭からカーソル位置前まで削除
ChangeFlag% = OK
tmp$ = MID$(tmp$ + SPACE$(Length%), dx% + 1)
dx% = 0
CASE IS >= " " '文字入力
ChangeFlag% = OK
'ひらがな, かたかなの半角化処理
IF strflag% < 0 THEN
A$ = CSNG$(A$)
END IF
IF strflag% > 0 THEN
A$ = CDBL$(A$)
END IF
IF strflag% > 0 THEN A$ = CDBL$(A$)
IF strflag% = 0 OR (strflag% < 0 AND ASC(A$) < 256) OR (strflag% > 0 AND ASC(A$) >= 256) THEN
IF Ins% = NG THEN
tmp$ = tmp$ + " "
KMID$(tmp$, CharNum%, 1) = A$
ELSE
tmp$ = KMID$(tmp$, 1, CharNum% - 1) + A$ + KMID$(tmp$, CharNum%, LEN(tmp$) - CharNum% + 1)
END IF
IF ASC(A$) >= 256 THEN dx% = dx% + 1
dx% = dx% + 1
END IF
CASE ELSE
EXIT DO ' 以外は出す
END SELECT
LOOP
COLOR 7, 0
LOCATE Y0%, X0%, 0
PRINT tmp$;
Line.Edit$ = RTRIM$(tmp$)
XPOS = LEN(RTRIM$(tmp$))
IF XPOS < 36 AND strflag > -1 THEN
LOCATE Y0%, X0% + XPOS
textcolor 6
putc (&H1F)
textcolor 7
END IF
END FUNCTION
DEFSNG A-Z
SUB MENU
DIM SttLst$(1 TO 5)
RESTORE SttMsgLst
READ SttTtl$
FOR I% = LBOUND(SttLst$) TO UBOUND(SttLst$)
READ SttLst$(I%)
NEXT
DO
ANS% = BOXMENU%(26, 8, SttTtl$, SttLst$())
SELECT CASE ANS%
CASE 0
EXIT DO
CASE 1
Heiten
EXIT DO
CASE 2
Set.Data
EXIT DO
CASE 3
DATAX
EXIT DO
CASE 4
PageCopy
EXIT DO
CASE 5
Disp.TOKEI
EXIT DO
END SELECT
LOOP
END SUB
SUB New.Data
FOR J = 1 TO maxpage
FOR I = 1 TO 12
Save.Data$ = Save.Data$ + SPACE$(36)
Save.Saizu$ = Save.Saizu$ + "1"
NEXT I
Saizu.Data(J) = Save.Saizu$
Bun.Data(J) = Save.Data$
NEXT J
OPEN Drive$ FOR OUTPUT AS #1
FOR rec = 1 TO maxpage
WRITE #1, Saizu.Data(rec)
WRITE #1, Bun.Data(rec)
NEXT
CLOSE #1
END SUB
SUB NO.Data
bell 800, 32: bell 620, 40
box 22, 19, 59, 21, 11, 2
COLOR 11
LOCATE 20, 31, 0: PRINT "データが、ありません."
COLOR 7
END SUB
SUB PageCopy
Data.Save
gettext
box 23, 5, 58, 16, 3, 0
gotoxy 35, 5: textcolor 19: puts "Page Copy": textcolor 7
Ins% = NG
IN.1:
gotoxy 29, 8: puts "コピー元の Page No. ?"
LOCATE 8, 51
Copy.Form$ = Line.Edit$(Copy.Form$, 2, LastKey$, -1)
IF LastKey$ = CHR$(27) OR Copy.Form$ = "" THEN GOTO EX
IF VAL(Copy.Form$) < 1 OR VAL(Copy.Form$) > 30 THEN bell 600, 32: GOTO IN.1
IN.2:
gotoxy 29, 11: puts "コピー先の Page No. ?"
LOCATE 11, 51
Copy.To$ = Line.Edit$(Copy.To$, 2, LastKey$, -1)
IF LastKey$ = CHR$(27) OR Copy.To$ = "" THEN GOTO EX
IF VAL(Copy.To$) < 1 OR VAL(Copy.To$) > 30 THEN bell 600, 32: GOTO IN.2
IF VAL(Copy.To$) = VAL(Copy.Form$) THEN bell 600, 32: GOTO IN.2
gotoxy 31, 14: puts "○:実 行 ×:取 消"
DO
A$ = In.Key$
SELECT CASE A$
CASE CHR$(13)
Saizu.Data(VAL(Copy.To$)) = Saizu.Data(VAL(Copy.Form$))
Bun.Data(VAL(Copy.To$)) = Bun.Data(VAL(Copy.Form$))
EXIT DO
CASE CHR$(24), CHR$(27)
EXIT DO
CASE ELSE
bell 600, 32
END SELECT
LOOP
EX:
puttext
Ins% = OK
Disp.Page Page.No%
END SUB
'------------------
' LABEL.DEF セーブ
'------------------
SUB Save.DEF
OPEN CurDir$ + "LABEL.DEF" FOR RANDOM AS 2 LEN = 48
FIELD #2, 36 AS Drive.Name$, 12 AS Sonota.Data$
GET #2, 1
DN$ = "": SD$ = ""
FOR WD = 1 TO 4
SD$ = SD$ + RIGHT$(" " + SONO$(WD), 3)
NEXT WD
LSET Drive.Name$ = LEFT$(Drive$ + SPACE$(36), 36)
LSET Sonota.Data$ = SD$
PUT #2, 1
CLOSE #2
END SUB
'--------------------
' ちょっとだけ設定
'--------------------
SUB Set.Data
CCY = 6: CCX = 45
Data.Save
gettext
box 16, 4, 65, 17, 6, 3
box 22, 11, 59, 13, 3, 0
COLOR 22
LOCATE 4, 32: PRINT " ちょっとだけ設定 "
COLOR 3
LOCATE 6, 23: PRINT "印刷開始紙送り量(行) 行 3"
LOCATE 7, 23: PRINT "左マージン(1/180インチ) 10"
LOCATE 8, 23: PRINT "改行ピッチ(1/180インチ) 1 から 60 30"
LOCATE 9, 23: PRINT "印刷後改ページ有り? 0:無 1:有 0"
COLOR 0, 3
LOCATE 11, 23: PRINT "データドライブ&データ名"
LOCATE 13, 23: PRINT CurDir$ ' カレントディレクトリィ
COLOR 7, 0
LOCATE 15, 31: PRINT "ESC: 中止 F1: Save"
FOR I = 1 TO 4
SONO$(I) = MID$(STR$(Sonota(I)), 2)
LOCATE I + 5, 45: PRINT USING "& &"; SONO$(I)
NEXT I
LOCATE 12, 23: PRINT Drive$
' Sonota(1) = 印刷開始紙送り量(行)
' Sonota(2) = 左マージン(1/180インチ)
' Sonota(3) = 改行ピッチ(1/180インチ)
' Sonota(4) = 印刷後改ページ有り?
DO
F11START:
LOCATE CCY, CCX
Ins% = NG
IF CCY = 12 THEN
Input.Drive:
Ins% = OK
LOCATE CCY, 23
IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = CurDir$ + Drive$
Drive$ = Line.Edit$(Drive$, 36, LastKey$, 0)
IF Drive$ <= SPACE$(36) OR LEN(Drive$) = LEN(CurDir$) THEN
bell 800, 32: bell 620, 40
box 22, 19, 59, 21, 14, 2
COLOR 7
LOCATE 20, 28: PRINT "データ名を入力してください."
GOTO Input.Drive
END IF
IF MID$(Drive$, 2, 1) <> ":" THEN Drive$ = LEFT$(CurDir$ + Drive$ + SPACE$(36), 36)
Drive$ = UCASE$(Drive$): LOCATE CCY, 23: PRINT Drive$
ELSE
I = CCY - 5
SONO$(I) = Line.Edit$(SONO$(I), 3, LastKey$, -1)
Sonota(I) = VAL(SONO$(I))
LOCATE CCY, 45: PRINT USING "& &"; SONO$(I)
IF Sonota(3) = 0 OR Sonota(3) > 60 THEN bell 600, 32: Sonota(3) = 30: GOTO F11START
IF Sonota(4) > 1 THEN bell 600, 32: Sonota(4) = 0: GOTO F11START
END IF
SELECT CASE LastKey$
CASE CHR$(13), CHR$(0, &H50), CHR$(&H18) ' リターンキー ,↓ DOWN
SELECT CASE CCY
CASE 12
CCY = 6
CASE 9
CCY = 12
CASE ELSE
CCY = CCY + 1
END SELECT
CASE CHR$(0, &H3B) ' PF1
puttext
Save.DEF
Drive$ = RTRIM$(Drive$)
Disp.Name
Ins% = OK
EXIT SUB
CASE CHR$(&H1B) ' ESC
EXIT DO
CASE CHR$(0, &H48), CHR$(&H5) ' ↑ UP
SELECT CASE CCY
CASE 6
CCY = 12
CASE 12
CCY = 9
CASE ELSE
CCY = CCY - 1
END SELECT
END SELECT
LOOP
puttext
Ins% = OK
END SUB
'------------------
' 文字サイズ設定
'------------------
SUB Set.KGM (SetNO AS INTEGER)
SELECT CASE SetNO
CASE 0, 1
Print.Data$ = "○ "
CASE 2
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
Print.Data$ = " ○ "
CASE 3
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
IF N = 12 THEN Boo: EXIT SUB
IF In$(N + 1) <= SPACE$(36) THEN ELSE Boo: EXIT SUB
Print.Data$ = " ○ "
CASE 4
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
IF N = 12 THEN Boo: EXIT SUB
IF In$(N + 1) <= SPACE$(36) THEN ELSE Boo: EXIT SUB
Print.Data$ = " ○"
END SELECT
Saizu(N) = SetNO
LOCATE N + 4, 10: PRINT Print.Data$
END SUB
SUB UpPage (Page%, Count%)
Data.Set
Page.No% = Page% + Count%
IF Page.No% > maxpage% THEN Page.No% = 1
Disp.Page Page.No%
END SUB
'--------------------
' 左寄・中央・右寄
'--------------------
SUB Write.LCR (FG AS INTEGER)
IF In$(N) <= SPACE$(36) THEN NO.Data: EXIT SUB
In$(N) = LTRIM$(In$(N)) ' 先頭空白文字の除去 (ひだりよせ)
SELECT CASE FG
CASE 2 ' センタリング
Dmy$ = LEFT$(In$(N), 2)
SNSP = LEN(In$(N))
' IF ASC(Dmy$) <= 255 THEN ' ANK
SSP = (36 - SNSP) \ 2
In$(N) = LEFT$((SPACE$(SSP) + In$(N)), 36)
' ELSE ' 漢字
' SSP = (18 - SNSP) \ 2
' In$(N) = LEFT$((STRING$(SSP, " ") + In$(N)), 36)
' ' 全角スペース
' END IF
CASE 3 ' みぎよせ
Dmy$ = LEFT$(In$(N), 2)
MNSP = LEN(In$(N))
' IF ASC(Dmy$) <= 255 THEN ' ANK
MSP = 36 - MNSP
In$(N) = MID$((SPACE$(MSP) + In$(N)), 1, 36)
' ELSE ' 漢字
' MSP = 18 - MNSP
' In$(N) = MID$((STRING$(MSP, " ") + In$(N)), 1, 36)
' ' 全角スペース
' END IF
END SELECT
LOCATE CY, 23: PRINT SPACE$(36);
LOCATE CY, 23: PRINT In$(N);
END SUB